home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d12 / tess_5.arc / TSDAYTI5.PAS < prev   
Pascal/Delphi Source File  |  1990-08-18  |  18KB  |  530 lines
  1. {****************************************************************************
  2.  * TSDAYTIM.PAS -- Turbo Pascal 5.0 demonstration program
  3.  *      Rev 1.5   09 May 1988 19:49:50
  4.  *   change TsrbackCheck from boolean to word!
  5.  *   
  6.  *      Rev 1.4   30 Apr 1988 15:43:52
  7.  *   changed procedures for functions
  8.  *   
  9.  *      Rev 1.3   29 Apr 1988 19:51:56
  10.  *   changed SetAdr to TsSetAdrTP4
  11.  *   
  12.  *      Rev 1.2   22 Apr 1988 17:45:06
  13.  *   changed names of TS Library Functions
  14.  *   
  15.  *      Rev 1.1   22 Apr 1988 12:24:56
  16.  *   Begin conversion to new name, 'TesSeRact'
  17.  *   
  18.  *      Rev 1.0   04 Apr 1988 17:44:46
  19.  *   Initial revision.
  20.  * 
  21.  ***************************************************************************
  22.  SUBTTL    TesSeRact Revision Level 1
  23.  ;--------------------------------------------------------------------------
  24.  ;   TesSeRact(tm) -- A Library of Routines for Creating Ram-Resident (TSR)
  25.  ;                    programs for the IBM PC and compatible Personal
  26.  ;                    Computers.
  27.  ;
  28.  ;The software, documentation and source code are: 
  29.  ; 
  30.  ;    Copyright (C) 1986, 1987, 1988 Tesseract Development Team
  31.  ;    All Rights Reserved 
  32.  ; 
  33.  ;    c/o Chip Rabinowitz
  34.  ;    Innovative Data Concepts
  35.  ;    2084 Woodlawn Avenue
  36.  ;    Glenside, PA 19038
  37.  ;    1-215-884-3373
  38.  ;
  39.  ;--------------------------------------------------------------------------
  40.  ;   This product supports the TesSeRact Standard for Ram-Resident Program 
  41.  ;   Communication.  For information about TesSeRact, contact the TesSeRact 
  42.  ;   Development Team at:
  43.  ;       Compuserve:    70731,20
  44.  ;       MCIMAIL:       315-5415
  45.  ;   This MCIMAIL Account has been provided to the TesSeRact Development
  46.  ;   Team by Borland International, Inc.  The TesSeRact Development Team
  47.  ;   is in no way associated with Borland International, Inc.
  48.  ;--------------------------------------------------------------------------}
  49.  
  50. PROGRAM TSDayTi5;      { Copyright 1988 TesSeRact Development Team      }
  51. {$R-,S-,I-,D+,F-,V-,B-,N-,L+ }
  52. {$M 1024,0,0 }          { this line needed to reduce stack and heap!      }
  53. Uses DOS, CRT, TESSTP5;      { program redone 02-24-88, Jim Kyle, for RDT      }
  54. {*************************************************************************
  55.  *  This program is a VERY simple-minded TSR that merely displays the     *
  56.  *  time and date in the top RH corner, and which can also pop up and     *
  57.  *  remove itself from memory.    All of the fancy frills (snow-free write *
  58.  *  to CGA screens, full compatibility with EGA/VGA modes, file I/O, and *
  59.  *  the like) have been left out, to concentrate on those actions which  *
  60.  *  are REQUIRED to interface TesSeRact with Turbo Pascal 4 programs.     *
  61.  *************************************************************************}
  62.  
  63.               { first we declare constants and such.......      }
  64. CONST
  65.   MAXVIDSIZE =     2000 ;         { TP4 version only uses 80x25      }
  66.   MONONORM =     $07 ;
  67.   MONOREV =     $70 ;
  68.  
  69. VAR
  70.  savescreen : array [1..MAXVIDSIZE] of word ;
  71.                     { buffer to save screen image      }
  72.  NormAtt,                { Default Normal Attribute      }
  73.  RevAtt,                { Default Reverse Attribute      }
  74.  curmode,                { Current video mode          }
  75.  oldcur,                { Old Cursor shape          }
  76.  oldpos : word;             { Old Cursor position          }
  77.  biosvid : pointer;            { Pointer to video buffer      }
  78.  BackStack : array [0..1023] of char;    { Stack area for BackGround      }
  79.  buffer : array [0..17] of byte ;    { work buffer for date/time format}
  80.  BackFlag : word;            { Background flag to signal      }
  81.                     {   additional processing      }
  82.  idnum,                 { TSR Identification Number      }
  83.  hours,                 { Current hour of day          }
  84.  mins,                    { Current minute of hour      }
  85.  secs,                    { Current seconds of minute      }
  86.  yr,                    { for date report          }
  87.  mon,
  88.  day,
  89.  ticks : word;                { Timer-tick counter          }
  90.  regs  : registers;            { workspace for INTR interfaces   }
  91.  
  92. {***********************************************************
  93.  *  Video Support Routines                   *
  94.  *********************************************************CR}
  95.  
  96. PROCEDURE c_str( row : integer; str : string );
  97.                     { Print a string, centered      }
  98.   VAR
  99.     wid : integer;            { temporary width variable      }
  100.   BEGIN
  101.     wid := (80 - length(str)) SHR 1;    { calculate cursor position      }
  102.     gotoxy(wid, row);            { go there              }
  103.     write(str);             { display the string          }
  104.   END;
  105.  
  106. PROCEDURE getscrn;            { very primitive screen saver      }
  107.   BEGIN                 { WILL snow with CGA...       }
  108.     move( biosvid^, savescreen, sizeof(savescreen) );
  109.   END;
  110.  
  111. PROCEDURE putscrn;            { very primitive screen restore   }
  112.   BEGIN                 { WILL snow with CGA...       }
  113.     move( savescreen, biosvid^, sizeof(savescreen) );
  114.   END;
  115.  
  116. PROCEDURE SaveCursor;            { save current cursor size and      }
  117.   BEGIN                 {   position              }
  118.     Regs.AH := 3;            { Get Cursor Position          }
  119.     Regs.BH := 0;
  120.     Intr( $10, Regs );
  121.     oldpos := Regs.DX;            { Save return values          }
  122.     oldcur := Regs.CX;
  123.                     { known bug on some monochrome      }
  124.                     {   adapters reports the wrong      }
  125.                     {   cursor shape when both color  }
  126.                     {   and monochrome systems are      }
  127.                     {   installed.              }
  128.     IF( (curmode = MONO) AND  (oldcur = $0607) ) THEN
  129.     oldcur := $0c0d;
  130.     Regs.AH := 1;
  131.     Regs.CX := $ffff;
  132.     Intr( $10, Regs );
  133.   END;
  134.  
  135. PROCEDURE RestoreCursor;        { restore saved cursor position   }
  136.   BEGIN                 {   and size              }
  137.     Regs.AH := 2;            { restore saved position      }
  138.     Regs.BH := 0;
  139.     Regs.DX := oldpos;
  140.     Intr( $10, Regs );
  141.     Regs.AH := 1;            { restore saved cursor type      }
  142.     Regs.BH := 0;
  143.     Regs.CX := oldcur;
  144.     Intr( $10, Regs );
  145.   END;
  146.  
  147. {****************************< FixRows         >******************************
  148. *                                        *
  149. *          Determine current video mode and set it up            *
  150. *          ------------------------------------------            *
  151. *                                        *
  152. *   This function determines the current video mode at popup time, and        *
  153. *    if it is one of the four text modes sets to 80 columns, the        *
  154. *    default color scheme, and initializes the video RAM pointer.        *
  155. *   Note that this program does NOT restore to 40-column mode after popping *
  156. *    up; that, like de-snowing the video, is left for you to program.    *
  157. *                                        *
  158. *   Parameters:                                 *
  159. *    None                                    *
  160. *                                        *
  161. *   Returns:                                    *
  162. *    None                                    *
  163. *                                        *
  164. *************************************************************************CR}
  165.  
  166. PROCEDURE fixrows;            { Re-initialize current video      }
  167.   BEGIN                 {   information for new instance  }
  168.                     {   of video usage          }
  169.     curmode := word( mem[$40:$49] );    { Get current mode at popup      }
  170.     CASE (curmode) OF            { deal with text modes          }
  171.       BW40:
  172.     BEGIN
  173.       textmode(BW80);        { we need 80 columns          }
  174.       NormAtt := MONONORM;        { use Monochrome Attributes      }
  175.       RevAtt := MONOREV;
  176.     END;
  177.       BW80, MONO:
  178.     BEGIN
  179.       NormAtt := MONONORM;        { use Monochrome Attributes      }
  180.       RevAtt := MONOREV;
  181.     END;
  182.       C40:
  183.     BEGIN
  184.       textmode(C80);        { we need 80 columns          }
  185.                     { use Color attributes          }
  186.       NormAtt := (YELLOW + (BLUE SHL  4)) ;
  187.       RevAtt := (WHITE + (RED SHL  4)) ;
  188.     END;
  189.       C80:
  190.     BEGIN                { use Color attributes          }
  191.       NormAtt := (YELLOW + (BLUE SHL  4)) ;
  192.       RevAtt := (WHITE + (RED SHL  4)) ;
  193.     END;
  194.       END;
  195.  
  196.     IF(curmode = MONO) THEN        { If monochrome ....          }
  197.       biosvid := ptr($b000,124)     { ... set pointer          }
  198.     else                { That means color ....       }
  199.       biosvid := ptr($b800,124);    { ... so set pointer          }
  200.   END;
  201.  
  202. {****************************< SizeOfCode    >******************************
  203. *                                        *
  204. *          Determine size of program to keep resident            *
  205. *          ------------------------------------------            *
  206. *                                        *
  207. *   This function is an example of a function that can be used to determine *
  208. *    the size of the TSR that is to remain resident.  For use with TP4,  *
  209. *    no parameters are supplied and the value is like that for ALLHEAP   *
  210. *    with MSC 5.0 or Turbo C 1.5; the stack is below the heap and the    *
  211. *    entire heap and stack are counted in the value.             *
  212. *                                        *
  213. *   Parameters:                                 *
  214. *    None                                    *
  215. *                                        *
  216. *   Returns:                                    *
  217. *    Number of 16-byte paragraphs of memory to keep when going resident. *
  218. *                                        *
  219. *************************************************************************CR}
  220.  
  221. FUNCTION SizeOfCode : word;
  222.   VAR
  223.     used : word;
  224.   BEGIN
  225.   used := Seg(HeapPtr^) - PrefixSeg;    { these are built-ins for TP4..   }
  226.   SizeOfCode := used;            { return number of paragraphs      }
  227. END;
  228.  
  229. {****************************< do_cpyrt      >******************************
  230. *                                        *
  231. *            Display Copyright Information                *
  232. *            -----------------------------                *
  233. *                                        *
  234. *   Function to display formatted copyright information on the screen.        *
  235. *                                        *
  236. *   Parameters:                                 *
  237. *    none                                    *
  238. *                                        *
  239. *   Returns:                                    *
  240. *    none                                    *
  241. *                                        *
  242. *************************************************************************CR}
  243.  
  244. PROCEDURE do_cpyrt;
  245.   BEGIN
  246.     ClrScr;
  247.     textattr := RevAtt;
  248.     c_str(2, ' TesSeRact Date/Time Demonstration Program ');
  249.     textattr := NormAtt;
  250.     c_str(4, 'Copyright 1986, 1987, 1988, TesSeRact Development Team');
  251.     c_str(5, 'All Rights Reserved');
  252.   END;
  253.  
  254. {****************************< DisplayTime   >******************************
  255. *                                        *
  256. *              'Poke' current time into video RAM                    *
  257. *              ----------------------------------            *
  258. *                                        *
  259. *   Converts the date and time values from binary to ASCII, then pokes        *
  260. *    into rightmost 18 locations of the Video RAM segment for top row.   *
  261. *                                        *
  262. *   Parameters:                                 *
  263. *    none                                    *
  264. *                                        *
  265. *   Returns:                                    *
  266. *    none                                    *
  267. *                                        *
  268. *************************************************************************CR**}
  269.  
  270. PROCEDURE DisplayTime;
  271.   VAR
  272.      i: integer ;
  273.      j: integer ;
  274.      vidram : pointer;
  275.   BEGIN
  276.     vidram := biosvid;
  277.     yr := yr MOD 100;
  278.     buffer[0]  := (mon     DIV 10) + $30;
  279.     buffer[1]  := (mon     MOD 10) + $30;
  280.     buffer[2]  := ORD('/');
  281.     buffer[3]  := (day     DIV 10) + $30;
  282.     buffer[4]  := (day     MOD 10) + $30;
  283.     buffer[5]  := ORD('/');
  284.     buffer[6]  := (yr     DIV 10) + $30;
  285.     buffer[7]  := (yr     MOD 10) + $30;
  286.     buffer[8]  := ORD(' ');
  287.     buffer[9]  := ORD(' ');
  288.     buffer[10] := (hours DIV 10) + $30;
  289.     buffer[11] := (hours MOD 10) + $30;
  290.     buffer[12] := ORD(':');
  291.     buffer[13] := (mins  DIV 10) + $30;
  292.     buffer[14] := (mins  MOD 10) + $30;
  293.     buffer[15] := ORD(':');
  294.     buffer[16] := (secs  DIV 10) + $30;
  295.     buffer[17] := (secs  MOD 10) + $30;
  296.     FOR i := 0 TO 17 DO
  297.       BEGIN
  298.     j := word(vidram^) AND $FF00;
  299.     j := j OR buffer[i];
  300.     word(vidram^) := j;
  301.     vidram := pointer( longint( vidram ) + 2 );
  302.       END
  303.   END;
  304.  
  305. {****************************< AdjustTime    >******************************
  306. *                                        *
  307. *              Call DOS to get the current time                *
  308. *              --------------------------------                *
  309. *                                        *
  310. *     Calls DOS to get the current time into appropriate global values,     *
  311. *   then adjusts the "ticks" value more accurately from the 1/100 sec       *
  312. *   value returned by DOS.  Repeats to get date similarly.            *
  313. *                                        *
  314. *   Parameters:                                 *
  315. *    none                                    *
  316. *                                        *
  317. *   Returns:                                    *
  318. *    none                                    *
  319. *                                        *
  320. *************************************************************************CR**}
  321.  
  322. PROCEDURE AdjustTime;
  323.   VAR
  324.     WkDy,
  325.     Sec100 : word;
  326.   BEGIN
  327.     gettime( hours, mins, secs, Sec100 );
  328.     ticks := longint(91 * (100 - Sec100)) div 500;
  329.     getdate( yr, mon, day, wkdy );
  330.   END;
  331.  
  332. {****************************< InitTsrDemo   >******************************
  333. *                                        *
  334. *               Initialize variables and video                *
  335. *               ------------------------------                *
  336. *                                        *
  337. *   This function just initializes everything, displays a sign-on message,  *
  338. *    and gets the clock info for the first time.                *
  339. *                                        *
  340. *   Parameters:                                 *
  341. *    none                                    *
  342. *                                        *
  343. *   Returns:                                    *
  344. *    none                                    *
  345. *                                        *
  346. *************************************************************************CR**}
  347.  
  348. PROCEDURE InitTsrDemo;
  349.   BEGIN
  350.     curmode := LastMode AND $7F;    { save current mode for later      }
  351.     fixrows;
  352.     window(1,1,80,8);
  353.     textattr := NormAtt;
  354.     do_cpyrt;
  355.     c_str(7,' Press Alt-LeftShift-T to activate the TesSeRact Demonstration Program ');
  356.     AdjustTime;
  357.     DisplayTime;
  358.   END;
  359.  
  360. {*************************************************************
  361.  *   TSR Procedures                         *
  362.  *********************************************************CR**}
  363.  
  364. {$F+} PROCEDURE TsrMain; {$F-}
  365.   VAR
  366.     oldstat, ret : word;
  367.  
  368.   BEGIN
  369.     SaveCursor;
  370.     fixrows;                { determine video mode        }
  371.     CASE (curmode) OF
  372.       0..3, 7:                { if in any text mode....    }
  373.     BEGIN
  374.       window(1,1,80,25);
  375.       getscrn;            { save current screen first..    }
  376.       textattr := (NormAtt);
  377.       clrscr;            { wipe it clean for the popup    }
  378.       do_cpyrt;
  379.       oldstat := TsGetStat(idnum); { get the RM status word    }
  380.  
  381.       gotoxy(5,7);
  382.       write('This TSR is currently using the following procedures:');
  383.       IF(oldstat AND TSRUSEPOPUP)<>0 THEN
  384.         BEGIN
  385.           gotoxy(10,wherey+1);
  386.           write('User-Defined PopUp Procedure');
  387.         END;
  388.       IF(oldstat AND TSRUSEBACK)<>0 THEN
  389.         BEGIN
  390.           gotoxy(10,wherey+1);
  391.           write('User-Defined Background Procedure');
  392.         END;
  393.       IF(oldstat AND TSRUSETIMER)<>0 THEN
  394.         BEGIN
  395.           gotoxy(10,wherey+1);
  396.           write('User-Defined Timer Procedure');
  397.         END;
  398.       IF(oldstat AND TSRUSEUSER)<>0 THEN
  399.         BEGIN
  400.           gotoxy(10,wherey+1);
  401.           write('User-Defined User Communication Procedure');
  402.         END;
  403.  
  404.     c_str(24,'Press "R" to remove TSR from memory; any other key to return');
  405.  
  406.       repeat            { wait for any keypress     }
  407.         ret := ord(ReadKey);
  408.       until ret <> 0;
  409.       IF(char(ret AND $5F) = 'R') THEN
  410.         ret := TsRelease(idnum);    { release if requested to do so }
  411.       putscrn;            { put screen back as it was    }
  412.       RestoreCursor;
  413.     END                {   of text mode popup        }
  414.       ELSE                { If in graphics mode ....    }
  415.     TessBeep;            {   Beep and exit        }
  416.     END;    { of CASEs }
  417.  
  418.   END;
  419.  
  420. {$F+} FUNCTION TsrBackCheck : word; {$F-}
  421.   BEGIN
  422.     TsrBackCheck := (BackFlag);
  423.   END;
  424.  
  425. {$F+} PROCEDURE TsrBackProc; {$F-}
  426.   BEGIN
  427.     AdjustTime;     { call DOS to resynchronize the display  }
  428.     DisplayTime;
  429.     BackFlag := 0;
  430.   END;
  431.  
  432. {$F+} PROCEDURE TsrTimerProc; {$F-}
  433. {   This procedure comes up at each timer tick, and sets the flag to
  434.   request background processing once each second.
  435.     The background procedure does the actual screen display and corrects
  436.   the "ticks" counter to the proper value, depending on when it gains
  437.   control.
  438. }
  439.   BEGIN
  440.     DEC ( ticks );            { bump the tick counter  }
  441.     IF (ticks < 1) OR (ticks > 20) THEN { catch any outofrange     }
  442.       BEGIN
  443.     ticks := 20;
  444.     BackFlag := 1;        { ask background to upd  }
  445.       END;    { of second counted }
  446.   END;
  447.  
  448. {$F+} PROCEDURE TsrUserProc( UserPtr : pointer ); {$F-}
  449.   BEGIN
  450.     write('This is the user procedure:  Passed ptr = ');
  451.     writeln( seg(UserPtr^), ':', ofs(UserPtr^), ' (decimal)' );
  452.   END;
  453.  
  454. {$F+} PROCEDURE TsrCleanUp ( RemoveTSR : Boolean ); {$F-}
  455. { This procedure, added in version 0.70, permits a TSR to "wipe its feet"
  456.   at release time, and MUST be used to perform the initialization code.
  457.   It is called twice by the TesSeRact routines: once, with RemoveTSR set
  458.   FALSE, from DoTsrInit, and again, with RemoveTSR set TRUE, from the
  459.   ReleaseTSR function.    If a TSR has files open, it can close them.  Here,
  460.   only a CRT message is produced.
  461. }
  462.   BEGIN
  463.     IF (RemoveTSR) THEN
  464.       BEGIN
  465.     Writeln( 'TSR Demo has been removed from memory.' );
  466.     ErrorAddr := NIL; { ALL: !!!THIS!!! was the bug that killed us }
  467.       END
  468.     ELSE
  469.       BEGIN        { install (setup) the TSR }
  470.     InitTsrDemo;
  471.       END
  472.   END;
  473.  
  474. {****************************< main         >******************************
  475. *                                        *
  476. *   Simple-minded main.  Calculates top of background stack region,        *
  477. *    sets the stack points for the TSR; tests to see if we are already   *
  478. *    resident; if so, displays ID number and exits.    If it is OK        *
  479. *    to install, calls InitTsrDemo, and then goes resident with        *
  480. *    DoTsrInit().                                *
  481. *                                        *
  482. *   Parameters:                                 *
  483. *    none                                    *
  484. *                                        *
  485. *   Returns:                                    *
  486. *    none                                    *
  487. *                                        *
  488. *************************************************************************CR}
  489. VAR
  490.     tsrname  : string[8];
  491.     defptr,
  492.     stackptr : pointer;         { Pointer to top of Background      }
  493.                     {   stack area              }
  494. BEGIN
  495.     DirectVideo := False;        { force I/O to go through BIOS      }
  496.     tsrname := 'TSDAYTI5';
  497.     TsSetAdrTP4( @TsrTimerProc, 0 );     { must set runtime addresses      }
  498.     TsSetAdrTP4( @TsrBackProc,  1 );     { to our own procedures       }
  499.     TsSetAdrTP4( @TsrMain,      2 );
  500.     TsSetAdrTP4( @TsrBackCheck, 3 );
  501.     TsSetAdrTP4( @TsrUserProc,  4 );
  502.     TsSetAdrTP4( @TsrCleanUp,   5 );
  503.     defptr := NIL;            { necessary due to TP type checks }
  504.     stackptr := @BackStack[(sizeof(BackStack)-3)];
  505.                     { Calculate new stack pointer      }
  506.                                         { See TSINTVEC.PAS for split stks }
  507.     TsSetStack(defptr^, stackptr^);    { Set Popup Stack to defptr and   }
  508.                     {   background stack to stackptr  }
  509.  
  510.                     { Are we already here? note [1].. }
  511.     IF(TsCheckResident( tsrname[1], idnum ) = $ffff) THEN
  512.       BEGIN                { Yep!                  }
  513.     writeln('The TesSeRact Date/Time Demo TSR has already been loaded.');
  514.     writeln('  Use ALT-LeftShift-T to PopUp the TsrMain() routine.');
  515.     write  ('  Use ID Number ', idnum, ' to communicate through ');
  516.     writeln( 'TesSeRact Multiplex functions.');
  517.     halt(1);
  518.       END;
  519.  
  520.     ClrScr;
  521.  
  522.     IF( TsDoInit(              { Try to go resident; no return    }
  523.     TSRHOT_T,
  524.     TSRPOPALT + TSRPOPLSHIFT,
  525.     TSRUSEPOPUP + TSRUSEBACK + TSRUSETIMER + TSRUSEUSER,
  526.     SizeOfCode)<>0 ) THEN          { returns only if attempt failed    }
  527.       writeln('DoTsrInit function failed!');
  528.  
  529. END.
  530.